home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0168_pouring sand.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  3KB  |  145 lines
  1. {
  2. poursand.pas
  3.  
  4. { Pouring sand simulator - by Marcin Borkowski 2:480/25.
  5.   VGA and patience required. Program simulates sand poured
  6.   from some height on a flat surface. There are different
  7.   grain densities and different grain colors - denser grains
  8.   are darker. I saw something similar this year during winter
  9.   vacation done from tho pieces of glass, water and sand - this
  10.   program tries to simulate physical effects taking place in
  11.   a real system. Denser grains falls faster and they form flatter
  12.   slopes. ESC ends simulation. }
  13.  
  14. const
  15.   maxgrains = 199;
  16.  
  17. type
  18.   data   = (x,y,c);
  19.  
  20. var
  21.   sand   : array[0..maxgrains,x..c]of integer;
  22.   bottom : array[0..639,0..1]of integer;
  23.   grains,source : integer;
  24.  
  25. procedure movedown(i : integer);
  26. var
  27.   moved : boolean;
  28.   j : integer;
  29.  
  30.   procedure totheleft;
  31.   var
  32.     j : integer;
  33.   begin
  34.     for j:=1 to sand[i,c] do
  35.       if (sand[i,y]>bottom[sand[i,x]-j,0]+1) and (sand[i,x]>8) then
  36.       begin
  37.         dec(sand[i,x],j);
  38.         sand[i,y]:=bottom[sand[i,x],0]+1;
  39.         moved:=true;
  40.         EXIT
  41.       end;
  42.   end;
  43.  
  44.   procedure totheright;
  45.   var
  46.     j : integer;
  47.   begin
  48.     for j:=1 to sand[i,c] do
  49.       if (sand[i,y]>bottom[sand[i,x]+j,0]+1) and (sand[i,x]<632)  then
  50.       begin
  51.         inc(sand[i,x],j);
  52.         sand[i,y]:=bottom[sand[i,x],0]+1;  {}
  53.         moved:=true;
  54.         EXIT
  55.       end;
  56.   end;
  57.  
  58. begin
  59.   moved:=false;
  60.   if random(2)<>0 then
  61.   begin
  62.     totheleft;
  63.     if not moved then totheright;
  64.   end
  65.   else
  66.   begin
  67.     totheright;
  68.     if not moved then totheleft;
  69.   end;
  70.   if moved then movedown(i)
  71. end;
  72.  
  73. procedure pour;
  74. var
  75.   i : integer;
  76.   addr : word;
  77.   dummy : byte;
  78.   px,py,pc : integer;
  79. begin
  80.   for i:=0 to grains do
  81.   begin
  82.     dec(sand[i,y],sand[i,c]);
  83.     if sand[i,y] shr 4<=bottom[sand[i,x],0] then
  84.     begin
  85.       sand[i,y]:=bottom[sand[i,x],0]+1;
  86.       movedown(i);
  87.       px:=sand[i,x];
  88.       py:=sand[i,y];
  89.       pc:=sand[i,c];
  90.       bottom[px,0]:=py;
  91.       bottom[px,1]:=pc;
  92.       Port[$3CE]:=08;
  93.       Port[$3CF]:=$80 shr (px and 7);   { Bit Mask }
  94.       addr:=80*(480-py)+px shr 3;
  95.       dummy:=mem[$A000:addr];           { load latches }
  96.       mem[$A000:addr]:=Lo(17-pc shl 1); { PutPixel - write mode #2 }
  97.       move(sand[grains],sand[i],6);
  98.       dec(grains);
  99.     end;
  100.   end;
  101.   while grains<maxgrains do
  102.   begin
  103.     inc(grains);
  104.     sand[grains,x]:=source;
  105.     sand[grains,y]:=16*400;
  106.     sand[grains,c]:=1+random(8);
  107.   end;
  108. end;
  109.  
  110. procedure colors16;
  111. var
  112.   i : integer;
  113. begin
  114.   Port[$3C8]:=0;
  115.   for i:=0 to 15 do
  116.   begin
  117.     Port[$3C9]:=3+4*i;
  118.     Port[$3C9]:=3+4*i;
  119.     Port[$3C9]:=3+4*i;
  120.     port[$3C0]:=i;
  121.     port[$3C0]:=i;
  122.   end;
  123.   port[$3C0]:=$30;
  124. end;
  125.  
  126. begin
  127.   asm mov ax,12h; int 10h end;
  128.   randomize;
  129.   colors16;
  130.   Port[$3C4]:=02;  Port[$3C5]:=$0F;
  131.   Port[$3CE]:=05;  Port[$3CF]:=(Port[$3CF] and $FD) or 2;
  132.   fillchar(sand,sizeof(sand),#0);
  133.   fillchar(bottom,sizeof(bottom),#0);
  134.   grains:=0;
  135.   source:=30+random(600);
  136.   sand[grains,x]:=source;
  137.   sand[grains,y]:=16*400;
  138.   sand[grains,c]:=1;
  139.   repeat
  140.     pour;
  141.     if random(10000)>9997 then source:=30+random(600)
  142.   until port[$60]=1;
  143.   asm mov ax,03h; int 10h end;
  144. end.
  145.